home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / sqledit.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  8KB  |  300 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       Generic SQL Property Editor                     }
  6. {                                                       }
  7. {       Copyright (c) 1999 Inprise Corporation          }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit SQLEdit;
  12.  
  13. interface
  14.  
  15. uses Windows, Messages, ActiveX, SysUtils, Forms, Classes, Controls, Graphics,
  16.   StdCtrls, ExtCtrls;
  17.  
  18. type
  19.  
  20.   TExecuteEvent = procedure of Object;
  21.  
  22.   TPopulateThread = class(TThread)
  23.   private
  24.     FExecuteEvent: TExecuteEvent;
  25.   public
  26.     constructor Create(ExecuteEvent: TExecuteEvent);
  27.     procedure Execute; override;
  28.   end;
  29.  
  30.   TGetTableNamesProc = procedure(List: TStrings; SystemTables: Boolean) of object;
  31.   TGetFieldNamesProc = procedure(const TableName: string; List: TStrings) of Object;
  32.  
  33.   TSQLEditForm = class(TForm)
  34.     OkButton: TButton;
  35.     HelpButton: TButton;
  36.     CancelButton: TButton;
  37.     AddFieldButton: TButton;
  38.     AddTableButton: TButton;
  39.     SQLLabel: TLabel;
  40.     FieldListLabel: TLabel;
  41.     TableListLabel: TLabel;
  42.     TopPanel: TPanel;
  43.     ButtonPanel: TPanel;
  44.     FieldsPanel: TPanel;
  45.     MetaInfoPanel: TPanel;
  46.     TableListPanel: TPanel;
  47.     TableFieldsSplitter: TSplitter;
  48.     MetaInfoSQLSplitter: TSplitter;
  49.     SQLMemo: TMemo;
  50.     Image1: TImage;
  51.     TableList: TListBox;
  52.     FieldList: TListBox;
  53.     procedure FormShow(Sender: TObject);
  54.     procedure HelpButtonClick(Sender: TObject);
  55.     procedure TableFieldsSplitterCanResize(Sender: TObject; var NewSize: Integer;
  56.       var Accept: Boolean);
  57.     procedure MetaInfoSQLSplitterCanResize(Sender: TObject;
  58.       var NewSize: Integer; var Accept: Boolean);
  59.     procedure MetaInfoSQLSplitterMoved(Sender: TObject);
  60.     procedure TableListClick(Sender: TObject);
  61.     procedure AddTableButtonClick(Sender: TObject);
  62.     procedure AddFieldButtonClick(Sender: TObject);
  63.     procedure SQLMemoExit(Sender: TObject);
  64.     procedure FormDestroy(Sender: TObject);
  65.     procedure SQLMemoEnter(Sender: TObject);
  66.   private
  67.     CharHeight: Integer;
  68.     FPopulateThread: TPopulateThread;
  69.     GetTableNames: TGetTableNamesProc;
  70.     GetFieldNames: TGetFieldNamesProc;
  71.     SQLCanvas: TControlCanvas;
  72.     procedure InsertText(Text: string; AddComma: Boolean = True);
  73.     procedure DrawCaretPosIndicator;
  74.     procedure PopulateTableList;
  75.     procedure PopulateFieldList;
  76.   end;
  77.  
  78. function EditSQL(var SQL: string; AGetTableNames: TGetTableNamesProc;
  79.   AGetFieldNames: TGetFieldNamesProc): Boolean; overload;
  80.  
  81. function EditSQL(SQL: TStrings; AGetTableNames: TGetTableNamesProc;
  82.   AGetFieldNames: TGetFieldNamesProc): Boolean; overload;
  83.  
  84.  
  85. implementation
  86.  
  87. {$R *.DFM}
  88.  
  89. uses LibHelp;
  90.  
  91. const
  92.   SSelect = 'select'; { Do not localize }
  93.   SFrom = 'from'; { Do not localize }
  94.  
  95. function EditSQL(var SQL: string; AGetTableNames: TGetTableNamesProc;
  96.   AGetFieldNames: TGetFieldNamesProc): Boolean;
  97. begin
  98.   with TSQLEditForm.Create(nil) do
  99.   try
  100.     GetTableNames := AGetTableNames;
  101.     GetFieldNames := AGetFieldNames;
  102.     SQLMemo.Lines.Text := SQL;
  103.     Result := ShowModal = mrOK;
  104.     if Result then
  105.       SQL := SQLMemo.Lines.Text;
  106.   finally
  107.     Free;
  108.   end;
  109. end;
  110.  
  111. function EditSQL(SQL: TStrings; AGetTableNames: TGetTableNamesProc;
  112.   AGetFieldNames: TGetFieldNamesProc): Boolean; overload;
  113. var
  114.   SQLText: string;
  115. begin
  116.   SQLText := SQL.Text;
  117.   Result := EditSQL(SQLText, AGetTableNames, AGetFieldNames);
  118.   if Result then
  119.     SQL.Text := SQLText;
  120. end;
  121.  
  122.  
  123. procedure TSQLEditForm.FormShow(Sender: TObject);
  124. begin
  125.   HelpContext := hcDADOSQLEdit;
  126.   SQLCanvas := TControlCanvas.Create;
  127.   SQLCanvas.Control := SQLMemo;
  128.   CharHeight := SQLCanvas.TextHeight('0');
  129.   FPopulateThread := TPopulateThread.Create(PopulateTableList);
  130. end;
  131.  
  132. procedure TSQLEditForm.FormDestroy(Sender: TObject);
  133. begin
  134.   if Assigned(FPopulateThread) then
  135.   begin
  136.     FPopulateThread.Terminate;
  137.     FPopulateThread.WaitFor;
  138.     FPopulateThread.Free;
  139.   end;
  140.   SQLCanvas.Free;
  141. end;
  142.  
  143. procedure TSQLEditForm.HelpButtonClick(Sender: TObject);
  144. begin
  145.   Application.HelpContext(HelpContext);
  146. end;
  147.  
  148. procedure TSQLEditForm.PopulateTableList;
  149. begin
  150.   if @GetTableNames = nil then Exit;
  151.   try
  152.     GetTableNames(TableList.Items, False);
  153.     if FPopulateThread.Terminated then Exit;
  154.     if TableList.Items.Count > 0 then
  155.     begin
  156.       TableList.ItemIndex := 0;
  157.       TableListClick(nil);
  158.     end;
  159.   except
  160.   end;
  161. end;
  162.  
  163. procedure TSQLEditForm.TableFieldsSplitterCanResize(Sender: TObject;
  164.   var NewSize: Integer; var Accept: Boolean);
  165. begin
  166.   Accept := (NewSize > 44) and (NewSize < (MetaInfoPanel.Height - 65));
  167. end;
  168.  
  169. procedure TSQLEditForm.MetaInfoSQLSplitterCanResize(Sender: TObject;
  170.   var NewSize: Integer; var Accept: Boolean);
  171. begin
  172.   Accept := (NewSize > 100) and (NewSize < (ClientWidth - 100));
  173. end;
  174.  
  175. procedure TSQLEditForm.MetaInfoSQLSplitterMoved(Sender: TObject);
  176. begin
  177.   SQLLabel.Left := SQLMemo.Left;
  178. end;
  179.  
  180. procedure TSQLEditForm.PopulateFieldList;
  181. begin
  182.   if @GetFieldNames = nil then Exit;
  183.   try
  184.     GetFieldNames(TableList.Items[TableList.ItemIndex], FieldList.Items);
  185.     FieldList.Items.Insert(0, '*');
  186.   except
  187.   end;
  188. end;
  189.  
  190. procedure TSQLEditForm.TableListClick(Sender: TObject);
  191. begin
  192.   PopulateFieldList;
  193. end;
  194.  
  195. procedure TSQLEditForm.InsertText(Text: string; AddComma: Boolean = True);
  196. var
  197.   StartSave: Integer;
  198.   S: string;
  199. begin
  200.   S := SQLMemo.Text;
  201.   StartSave := SQLMemo.SelStart;
  202.   if (S <> '') and (StartSave > 0) and not (S[StartSave] in [' ','(']) and
  203.     not (Text[1] = ' ') then
  204.   begin
  205.     if AddComma and (S[StartSave] <> ',') then
  206.       Text := ', '+Text else
  207.       Text := ' ' + Text;
  208.   end;
  209.   System.Insert(Text, S, StartSave+1);
  210.   SQLMemo.Text := S;
  211.   SQLMemo.SelStart := StartSave + Length(Text);
  212.   SQLMemo.Update;
  213.   DrawCaretPosIndicator;
  214. end;
  215.  
  216. procedure TSQLEditForm.AddTableButtonClick(Sender: TObject);
  217. var
  218.   TableName,
  219.   SQLText: string;
  220.   Blank: Boolean;
  221. begin
  222.   if TableList.ItemIndex > -1 then
  223.   begin
  224.     SQLText := SQLMemo.Text;
  225.     TableName := TableList.Items[TableList.ItemIndex];
  226.     Blank := SQLText = '';
  227.     if Blank or (Copy(SQLText, 1, 6) = SSelect) then
  228.       InsertText(Format(' %s %s', [SFrom, TableName]), False)
  229.     else
  230.       InsertText(TableName, False);
  231.     if Blank then
  232.     begin
  233.       SQLMemo.SelStart := 0;
  234.       SQLMemo.Update;
  235.       InsertText(SSelect+' ', False);
  236.     end;
  237.   end;
  238. end;
  239.  
  240. procedure TSQLEditForm.AddFieldButtonClick(Sender: TObject);
  241. var
  242.   I: Integer;
  243. begin
  244.   if FieldList.ItemIndex > -1 then
  245.   begin
  246.     { Help the user and assume this is a select if starting with nothing }
  247.     if SQLMemo.Text = '' then
  248.     begin
  249.       SQLMemo.Text := SSelect;
  250.       SQLMemo.SelStart := Length(SQLMemo.Text);
  251.     end;
  252.     for I := 0 to FieldList.Items.Count - 1 do
  253.       if FieldList.Selected[I] then
  254.         InsertText(FieldList.Items[I], (SQLMemo.Text <> SSelect) and (FieldList.Items[I] <> '*'));
  255.   end;
  256. end;
  257.  
  258. procedure TSQLEditForm.SQLMemoExit(Sender: TObject);
  259. begin
  260.   DrawCaretPosIndicator;
  261. end;
  262.  
  263. procedure TSQLEditForm.SQLMemoEnter(Sender: TObject);
  264. begin
  265.   { Erase the CaretPos indicator }
  266.   SQLMemo.Invalidate;
  267. end;
  268.  
  269. procedure TSQLEditForm.DrawCaretPosIndicator;
  270. var
  271.   XPos, YPos: Integer;
  272. begin
  273.   with SQLMemo.CaretPos do
  274.   begin
  275.     YPos := (Y+1)*CharHeight;
  276.     XPos := SQLCanvas.TextWidth(Copy(SQLMemo.Lines[Y], 1, X)) - 3 ;
  277.     SQLCanvas.Draw(XPos ,YPos, Image1.Picture.Graphic);
  278.   end;
  279. end;
  280.  
  281. { TPopulateThread }
  282.  
  283. constructor TPopulateThread.Create(ExecuteEvent: TExecuteEvent);
  284. begin
  285.   FExecuteEvent := ExecuteEvent;
  286.   inherited Create(False);
  287. end;
  288.  
  289. procedure TPopulateThread.Execute;
  290. begin
  291.   CoInitialize(nil);
  292.   try
  293.     FExecuteEvent;
  294.   except
  295.   end;
  296.   CoUninitialize;
  297. end;
  298.  
  299. end.
  300.